home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / forms / dmoc3d / democt3d.bas < prev    next >
Encoding:
BASIC Source File  |  1994-10-27  |  2.2 KB  |  55 lines
  1. ' DemoCt3D.Bas - Routines used with DemoCt3D.Mak
  2. ' 94/10/27 Copyright 1994, Larry Rebich, The Bridge, Inc.
  3.     Option Explicit
  4.     DefInt A-Z
  5.     Type OfStruct
  6.         cBytes As String * 1
  7.         fFixedDisk As String * 1
  8.         nErrCode As Integer
  9.         Reserved As String * 4
  10.         szPathName As String * 128
  11.     End Type
  12.  
  13.     Declare Function OpenFile Lib "Kernel" (ByVal lpFileName As String, lpReOpenBuff As OfStruct, ByVal wStyle As Integer) As Integer
  14.  
  15.     Global Const OF_EXIST = &H4000      'used to get date time last updated
  16.  
  17. Sub GetFileFullNameAndDateTime (FileName As String, FileFullName As String, FileDateAndTime As Double)
  18.     Const HFile_Error = -1      'error
  19.     Dim R As OfStruct           'variable as this type
  20.     Dim r1 As String * 1        'Reserved word
  21.     Dim r2 As String * 1
  22.     Dim r3 As String * 1
  23.     Dim r4 As String * 1
  24.     Dim Fe
  25.     Dim Da, Mo, Yr
  26.     Dim Hr, Mi, Se
  27.     Dim Temp As Long
  28.     Dim TempString As String    'full file name in here
  29.     Fe = OpenFile(FileName, R, OF_EXIST)        'API call, open then close
  30.     If Fe <> HFile_Error Then
  31.         r1 = Mid$(R.Reserved, 1, 1)             'reserved first byte
  32.         r2 = Mid$(R.Reserved, 2, 1)             'reserved second byte
  33.         r3 = Mid$(R.Reserved, 3, 1)             'reserved third byte
  34.         r4 = Mid$(R.Reserved, 4, 1)             'reserved fourth byte
  35.         Temp& = Asc(r2) * 256& + Asc(r1)
  36.         Da = (Temp& And &H1F)                   'day
  37.         Mo = (Temp& And &H1E0) \ &H20           'month
  38.         Yr = (Temp& And &HFE00) \ &H200 + 1980  'year
  39.         Temp& = Asc(r4) * 256& + Asc(r3)
  40.         Se = (Temp& And &H1F) * 2               'second
  41.         Mi = (Temp& And &H7E0) \ &H20           'minute
  42.         Hr = (Temp& And &HF800) \ &H800         'hour
  43.         FileDateAndTime = DateSerial(Yr, Mo, Da) + TimeSerial(Hr, Mi, Se)
  44.         TempString = RTrim$(R.szPathName)       'get file name
  45.         If InStr(TempString, Chr$(0)) > 0 Then  'dump ending null
  46.             TempString = Left$(TempString, InStr(TempString, Chr$(0)) - 1)
  47.         End If
  48.         FileFullName = TempString
  49.     Else
  50.         FileDateAndTime = 0
  51.         FileFullName = ""
  52.     End If
  53. End Sub
  54.  
  55.